package JasPerl::EL::ExpressionEvaluator;

use strict;
use warnings;

use Carp qw{ confess };

use JasPerl::EL::Expression;
use JasPerl::EL::CompositeExpression;

my @KEYWORDS = qw{
    and div empty eq false ge gt instanceof le lt mod ne not null or true
};

my ($EXPRESSION_PARSER, $COMPOSITE_PARSER) = do {
    use Regexp::Grammars v1.014;

    my %keywords = map { $_ => 1 } @KEYWORDS;

    sub unescape {
        my ($s, $q) = @_;

        # Prior to Perl 5.14, the regex engine is not reentrant...
        for (my $i = 0; ($i = index($s, "\\", $i)) >= 0; $i++) {
            my $m = substr($s, $i, 2);
            substr($s, $i, 2) = "\\" if $m eq "\\\\";
            substr($s, $i, 2) = $q if $m eq "\\$q";
        }
        return $s;
    }

    qr{
        <grammar: JasPerl::EL::Expression>

        <nocontext:>

        <rule: Expression>
            <[expr=Expression1]> (?: \? <[expr=Expression]> \: <[expr=Expression]> <op='cond'> )?
            <minimize:>

        <rule: Expression1>
            <[expr=Expression2]>+ % <[ops=BinaryOp1]>
            <minimize:>

        <rule: Expression2>
            <[expr=Expression3]>+ % <[ops=BinaryOp2]>
            <minimize:>

        <rule: Expression3>
            <[expr=Expression4]>+ % <[ops=BinaryOp3]>
            <minimize:>

        <rule: Expression4>
            <[expr=Expression5]>+ % <[ops=BinaryOp4]>
            <minimize:>

        <rule: Expression5>
            <[expr=Expression6]>+ % <[ops=BinaryOp5]>
            <minimize:>

        <rule: Expression6>
            <[expr=UnaryExpression]>+ % <[ops=BinaryOp6]>
            <minimize:>

        <rule: UnaryExpression>
            <op=UnaryOp> <[expr=UnaryExpression]>
          | <MATCH=Value>

        <rule: Value>
            <val=ValuePrefix> <[prop=ValueSuffix]>*
            (?{ $MATCH = $MATCH{val} unless exists $MATCH{prop} })

        <rule: ValuePrefix>
            <MATCH=Literal>
          | <MATCH=NonLiteralValuePrefix>

        <rule: NonLiteralValuePrefix>
            <var=Identifier>
          | <MATCH=FunctionInvocation>
          | \( <MATCH=Expression> \)

        <rule: ValueSuffix>
            \. <str=Identifier>
          | \[ <MATCH=Expression> \]

        <rule: FunctionInvocation>
            (<prefix=Identifier> \:)? <name=Identifier> \( <[args=Expression]>* % , \)

        <rule: Literal>
            <bool=BooleanLiteral>
          | <int=IntegerLiteral>
          | <num=FloatingPointLiteral>
          | <str=StringLiteral>
          | <null=NullLiteral>

        <token: Identifier>
            <MATCH=([A-Za-z_]\w*)> <require: (?{ not exists $keywords{$CAPTURE} })>

        <token: BooleanLiteral>
            <MATCH=(true | false)>

        <token: IntegerLiteral>
            <MATCH=(\d+)>

        <token: FloatingPointLiteral>
            <MATCH=(\d*\.\d*([eE][+-]?\d+)? | \d+[eE][+-]?\d+)>

        <token: StringLiteral>
            ( '(?: [^'\\] | \\' | \\\\ )*' | "(?: [^"\\] | \\" |\\\\ )*" )
            (?{ $MATCH = unescape(substr($CAPTURE, 1, -1), substr($CAPTURE, 0, 1)) })

        <token: NullLiteral>
            null <MATCH=(?{ undef })>

        <token: UnaryOp>
            (!|not) <MATCH='not'> | \- <MATCH='neg'> | empty

        <token: BinaryOp1>
            (\|\||or) <MATCH='or'>

        <token: BinaryOp2>
            (&&|and) <MATCH='and'>

        <token: BinaryOp3>
            (==|eq) <MATCH='eq'> | (!=|ne) <MATCH='ne'>

        <token: BinaryOp4>
            (<|lt) <MATCH='lt'>  | (>|gt) <MATCH='gt'> | (<=|le) <MATCH='le'> | (>=|ge) <MATCH='ge'>

        <token: BinaryOp5>
            \+ <MATCH='add'> | \- <MATCH='sub'>

        <token: BinaryOp6>
            \* <MATCH='mul'> | (\/|div) <MATCH='div'> | (\%|mod) <MATCH='mod'>
    }xms;

    qr{
        <extends: JasPerl::EL::Expression>

        <nocontext:>

        ^ \${ <expr=Expression> } $
    }xms, qr{
        <extends: JasPerl::EL::Expression>

        <nocontext:>

        ^ ( \${ <expr=Expression> } | ( <[comp=Text]> | \${ <[comp=Expression]> } )* ) $

        <token: Text>
            ( (?: [^\$] | \\\$ )+ )
            (?{ $MATCH = unescape($CAPTURE, '$') })
    }xms;
};

sub new {
    my ($class, %param) = @_;
    my $self = bless { }, $class;
    $self->{parser} = $param{composite} ? $COMPOSITE_PARSER : $EXPRESSION_PARSER;
    $self->{cache} = { } if $param{cache};
    return $self;
}

sub eval {
    my ($self, $expr, $resolver, $fnmapper) = @_;
    return $self->parse($expr, $fnmapper)->eval($resolver);
}

sub parse {
    my ($self, $src, $fnmapper) = @_;

    if (my $expr = $self->{cache}->{$src}) {
        return $expr;
    }

    my $actions = JasPerl::EL::ExpressionEvaluator::Actions->new($fnmapper);

    if ($src =~ $self->{parser}->with_actions($actions)) {
        my $expr = (exists $/{expr})
            ? JasPerl::EL::Expression->new($src, $/{expr})
            : JasPerl::EL::CompositeExpression->new($src, $/{comp})
            ;
        $self->{cache}->{$src} = $expr if exists $self->{cache};
        return $expr;
    } else {
        confess "Error parsing expression '$src'";
    }
}

package JasPerl::EL::ExpressionEvaluator::Actions;

use Carp qw{ confess };

sub new {
    my ($class, $fnmapper) = @_;
    my $self = bless \$fnmapper, $class;
}

sub FunctionInvocation {
    my ($self, $match) = @_;
    my $prefix = $match->{prefix} // '';

    my $fnmapper = ${$self}
        or confess "Expression uses functions, but no FunctionMapper provided";
    my $sub = $fnmapper->resolve_function($prefix, $match->{name})
        or confess "Cannot locate function $prefix:$match->{name}";
    return { sub => $sub, args => $match->{args} };
}

1;
